home *** CD-ROM | disk | FTP | other *** search
/ Aminet 22 / Aminet 22 (1997)(GTI - Schatztruhe)[!][Dec 1997].iso / Aminet / dev / amos / amos_col.lha / AMOS-COL / Editor.amos / Editor.amosSourceCode < prev    next >
AMOS Source Code  |  1980-01-10  |  19KB  |  854 lines
  1. '
  2. 'BY DELTA (based on Ben's Wyatt editor)
  3. 'DELTA:
  4. '�ukasz ï¿½elezny
  5. 'Ul. W�oska 4d/6 
  6. '42-612 Tarnowskie G�ry
  7. 'Poland
  8. '
  9. 'This program required AMOSPro_Delta.Lib 
  10. 'This file is PUBLIC DOMAIN! 
  11. '
  12. 'Date: 13.04.1996!   
  13. '
  14. Set Buffer 150
  15. BLOK
  16. Trap Screen Close 0 : Hide 
  17. Degree 
  18. Dim FILE$(100)
  19. Global AN,FILE$(),FI$,ED$,N,PASS
  20. Dim S(359),C(359) : For A=0 To 359 : S(A)=Sin(A)*16384 : C(A)=Cos(A)*16384 : Next A
  21. Global S(),C()
  22. LINES=1000 : L=0 : YPOS=0 : SZE=199 : WKSAZ=0
  23. Dim LINE$(LINES)
  24. Global LINES,TSCRHEIGHT,L,YPOS,FILENAME$,SZE,WSKAZ,ROT,MUZA
  25. Global LINE$()
  26. MUZA=1
  27. Track Play : Track Loop On 
  28. _TEXTEDITOR[0]
  29. Edit 
  30.  
  31. Procedure _TEXTEDITOR[SCR]
  32.    Screen Open 1,640,256,2,Hires
  33.    Wait Vbl 
  34.    Curs Off : Palette 0,$FFF
  35.    Double Buffer : Autoback 0
  36.    Screen Open SCR,640,255,4,Hires
  37.    Wait Vbl 
  38.    Cls 0
  39.    Dual Playfield 0,1
  40.    Colour 9,$AAA
  41.    Colour 17,$FF0
  42.    Colour 20,$BB0
  43.    Colour 24,$880
  44.    Colour 31,$660
  45.    Sprite 1,128,50,1
  46.    Amal 1,"P: Let X=XM-13; Let Y=YM; J P;"
  47.    Amal On 1
  48.    Screen Display 0,128,37,640,Screen Height
  49.    Palette $0,$80,$FFF,,$FFF
  50.    Cdown 
  51.    Cls 0
  52.    Cls 2,0,0 To 640,8
  53.    'Cls 2,624,8 To 640,Screen Height
  54.    TSCRHEIGHT=Screen Height/8-1
  55.    Scroll Off 
  56.    _LMOUSE
  57.    
  58.    Def Scroll 1,0,8 To 624,Screen Height,0,8
  59.    Def Scroll 2,0,16 To 624,Screen Height,0,-8
  60.    
  61.    Paper 0 : Pen 2
  62.    
  63.    Menu$(1)=" Project "
  64.    Menu$(1,1)=" Load    "
  65.    Menu$(1,2)=" Save    "
  66.    Menu$(1,3)=" Save As "
  67.    Menu$(1,4)=" Music   "
  68.    Menu$(1,5)=" About   "
  69.    Menu$(1,20)=" Quit    "
  70.    
  71.    Menu On 
  72.    
  73.    _TEXTUPDATE[0]
  74.    _CURSPOS
  75.    
  76.    Repeat 
  77.       
  78.       If Choice
  79.          
  80.          C1=Choice(1)
  81.          C2=Choice(2)
  82.          Menu Off 
  83.          
  84.          If C1=1
  85.             If C2=1
  86.                REQ
  87.                _LOAD[FI$]
  88.                _TEXTUPDATE[YPOS]
  89.             End If 
  90.             If C2=2
  91.                _SAVE[FILENAME$]
  92.                _TEXTUPDATE[YPOS]
  93.             End If 
  94.             If C2=3
  95.                FILENAME$="" : _SAVE[FILENAME$]
  96.                _TEXTUPDATE[YPOS]
  97.             End If 
  98.             If C2=4
  99.                If MUZA=1
  100.                   MUZA=0
  101.                   Track Stop 
  102.                Else 
  103.                   MUZA=1
  104.                   Track Play 
  105.                End If 
  106.             End If 
  107.          End If 
  108.          If C2=5
  109.             Screen Hide 0 : Screen Hide 1 : Wait Vbl 
  110.              Extension_25_0044 
  111.             Unpack 10 To 5
  112.             Colour 17,$FF0
  113.             Colour 20,$BB0
  114.             Colour 24,$880
  115.             Colour 31,$660
  116.              Extension_25_0034 
  117.             Repeat : Until Mouse Key<>0 or Inkey$<>""
  118.             Fade 2
  119.             Wait 25
  120.             Screen Close 5
  121.             Screen Show 0 : Screen Show 1
  122.          End If 
  123.          If C1=2
  124.          End If 
  125.          
  126.          If C1=3
  127.          End If 
  128.          
  129.          Menu On 
  130.          Clear Key 
  131.          
  132.       End If 
  133.       
  134.       X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : MC=Mouse Click : MK=Mouse Key
  135.       If MC=1 and Y>7
  136.          XC=X/8 : YC=Y/8
  137.          L=YPOS+YC-1
  138.          Locate Min(XC,Len(LINE$(L))),YC
  139.       End If 
  140.       
  141.       I$=Inkey$ : S=Scancode : A=Asc(I$) : SS=Scanshift
  142.       If A>0 or S>0 : _CHECK[I$,A,S,SS] : End If 
  143.       
  144.       If WSKAZ=0
  145.          SZE=SZE-2
  146.          _ZOOMGRID
  147.          If SZE=<25
  148.             WSKAZ=1
  149.          End If 
  150.       End If 
  151.       
  152.       If WSKAZ=1
  153.          SZE=SZE+2
  154.          _ZOOMGRID
  155.          If SZE=>300
  156.             WSKAZ=0
  157.          End If 
  158.       End If 
  159.       
  160.    Until C1=1 and C2=20
  161.    
  162. End Proc
  163. Procedure _TEXTUPDATE[ST]
  164.    
  165.    ' St=Start of text to print
  166.    
  167.    Cls 0,0,8 To 624,Screen Height
  168.    
  169.    X=X Curs : Y=Y Curs
  170.    Paper 0 : Pen 2
  171.    
  172.    For YPL=ST To ST+TSCRHEIGHT-1
  173.       Locate 0,YPL-ST+1
  174.       Print LINE$(YPL)
  175.    Next YPL
  176.    
  177.    Locate X,Y
  178.    
  179. End Proc
  180. Procedure _LOAD[FILE$]
  181.    On Error Proc BAD
  182.    Resume Label KONIEC
  183.    If FILE$<>""
  184.       Open In 1,FILE$
  185.       DLUG=Lof(1)
  186.       Close 
  187.       Reserve As Chip Data 12,DLUG
  188.       Bload FILE$,12
  189.       PL=Start(12)
  190.       For N=0 To LINES
  191.           Extension_15_0080 
  192.          LINE$(N)=""
  193.          If PL<Start(12)+Length(12)
  194.             LINE$(N)=Peek$(PL,78,Chr$(10))
  195.             Add PL,Len(LINE$(N))+1
  196.          End If 
  197.       Next N
  198.       
  199.       Erase 12
  200.       L=0 : YPOS=0 : X=0 : Y=1 : ST=0 : 
  201.       Locate 0,1 : Cline 
  202.       Cls 0,0,8 To 624,Screen Height
  203.       _CURSPOS
  204.    End If 
  205.    KONIEC:
  206. End Proc
  207. Procedure _SAVE[FILENAME$]
  208.    On Error Proc BAD
  209.    Resume Label KONIEC
  210.    X=X Curs : Y=Y Curs
  211.    
  212.    If FILENAME$=""
  213.       REQ:
  214.       FILENAME$=FI$
  215.    End If 
  216.    
  217.    Reserve As Chip Data 12,78*LINES
  218.    PL=Start(12)
  219.    For N=0 To LINES
  220.        Extension_15_0080 
  221.       Poke$ PL,LINE$(N)+Chr$(10)
  222.       Add PL,Len(LINE$(N))+1
  223.    Next N
  224.    Bsave FILENAME$,Start(12) To PL
  225.    Erase 12
  226.    
  227.    KONIEC:
  228.    Locate X,Y
  229.    
  230. End Proc
  231. Procedure _LMOUSE
  232.    Limit Mouse 130,39 To 128+318,37+Screen Height-2
  233. End Proc
  234. Procedure _CHECK[I$,A,S,SS]
  235.    On Error Proc BAD
  236.    Resume Label KONIEC
  237.    X=X Curs
  238.    
  239.    ' Normal Key 
  240.    If A>31 and Len(LINE$(L))<77
  241.       A1$=Left$(LINE$(L),X)
  242.       A2$=Right$(LINE$(L),Len(LINE$(L))-X)
  243.       LINE$(L)=A1$+I$+A2$
  244.       Inc X
  245.       Locate 0,Y Curs
  246.       Print LINE$(L);
  247.       Locate X,Y Curs
  248.    End If 
  249.    
  250.    ' Backspace+shift
  251.    If A=8 and SS<>0 and X=Len(LINE$(L))
  252.       LINE$(L)=""
  253.       Locate 0,Y Curs
  254.       X=0
  255.       Cline 
  256.       Locate X,Y Curs
  257.       Goto SKIP
  258.    End If 
  259.    
  260.    ' Backspace+shift
  261.    If A=8 and SS<>0 and X>0 and X<Len(LINE$(L))
  262.       LINE$(L)=Right$(LINE$(L),Len(LINE$(L))-X)
  263.       Locate 0,Y Curs
  264.       X=0
  265.       Cline 
  266.       Print LINE$(L)+" ";
  267.       Locate X,Y Curs
  268.       Goto SKIP
  269.    End If 
  270.    
  271.    ' Backspace
  272.    If A=8 and(L>0 or X>0)
  273.       If X=0
  274.          A1$=LINE$(L-1)
  275.          A2$=LINE$(L)
  276.          If Len(A1$+A2$)<=77
  277.             For N=L+1 To LINES
  278.                LINE$(N-1)=LINE$(N)
  279.             Next N
  280.             LINE$(LINES)=""
  281.             LINE$(L-1)=A1$+A2$
  282.             Dec L
  283.             If Y Curs=1
  284.                Curs Off : Wait Vbl 
  285.                Scroll 1 : Dec YPOS
  286.                Cls 0,0,8 To 624,16
  287.                Locate 0,1 : Print LINE$(L);
  288.                Curs On 
  289.             Else Cup 
  290.             End If 
  291.             Y=Y Curs
  292.             Def Scroll 3,0,Y*8+8 To 624,Screen Height,0,-8
  293.             Scroll 3
  294.             Locate 0,Y : Print LINE$(L);
  295.             Cls 0,0,248 To 624,256
  296.             Locate 0,TSCRHEIGHT : Print LINE$(YPOS+TSCRHEIGHT-1);
  297.             Locate Len(A1$),Y
  298.             Clear Key 
  299.          End If 
  300.       Else 
  301.          A1$=Left$(LINE$(L),X-1)
  302.          A2$=Right$(LINE$(L),Len(LINE$(L))-X)
  303.          LINE$(L)=A1$+A2$
  304.          Dec X
  305.          Locate 0,Y Curs
  306.          Print LINE$(L)+" ";
  307.          Locate X,Y Curs
  308.       End If 
  309.    End If 
  310.    
  311.    
  312.    ' Delete + shift 
  313.    If S=70 and SS<>0 and X>0 and X<Len(LINE$(L))
  314.       LINE$(L)=Left$(LINE$(L),X)
  315.       Locate 0,Y Curs
  316.       Cline 
  317.       Print LINE$(L)+" ";
  318.       Locate X,Y Curs
  319.       Goto SKIP
  320.    End If 
  321.    
  322.    ' Delete + shift 
  323.    If S=70 and SS<>0 and X=0
  324.       LINE$(L)=""
  325.       Locate 0,Y Curs
  326.       Cline 
  327.       Locate X,Y Curs
  328.       Goto SKIP
  329.    End If 
  330.    
  331.    
  332.    
  333.    ' Delete 
  334.    If S=70 and X<Len(LINE$(L))
  335.       A1$=Left$(LINE$(L),X)
  336.       A2$=Right$(LINE$(L),Len(LINE$(L))-X-1)
  337.       LINE$(L)=A1$+A2$
  338.       Locate 0,Y Curs
  339.       Print LINE$(L)+" ";
  340.       Locate X,Y Curs
  341.    End If 
  342.    
  343.    ' Return 
  344.    If A=13 and LINE$(LINES)=""
  345.       A1$=Left$(LINE$(L),X)
  346.       A2$=Right$(LINE$(L),Len(LINE$(L))-X)
  347.       LINE$(L)=A1$
  348.       For N=LINES-1 To L+1 Step -1
  349.          LINE$(N+1)=LINE$(N)
  350.       Next N
  351.       If Y Curs=TSCRHEIGHT
  352.          Curs Off : Wait Vbl 
  353.          Scroll 2 : Inc YPOS
  354.          Cls 0,0,Screen Height-8 To 624,Screen Height
  355.          Locate 0,TSCRHEIGHT : Print LINE$(L);
  356.          Cup : Curs On 
  357.       End If 
  358.       Inc L
  359.       MV=0
  360.       If Y Curs<TSCRHEIGHT : Locate 0,Y Curs+1
  361.       Else Inc YPOS
  362.       End If 
  363.       LINE$(L)=A2$
  364.       Y=Y Curs
  365.       Def Scroll 3,0,Y*8 To 624,Screen Height,0,8
  366.       Curs Off : Wait Vbl 
  367.       Scroll 3
  368.       Cls 0,0,Y*8-8 To 624,Y*8+8
  369.       Locate 0,Y-1 : Print LINE$(L-1);
  370.       Locate 0,Y : Print LINE$(L);
  371.       If Y<>TSCRHEIGHT : Locate 0,Y+1 : Print LINE$(L+1); : End If 
  372.       Locate 0,Y
  373.       Curs On 
  374.       Clear Key 
  375.    End If 
  376.    
  377.    ' Cursor left
  378.    If A=29 and X>0
  379.       If SS>0 : Locate 0,Y Curs
  380.       Else Cleft 
  381.       End If 
  382.    End If 
  383.    
  384.    ' Cursor right 
  385.    If A=28 and X<Len(LINE$(L))
  386.       If SS>0 : Locate Len(LINE$(L)),Y Curs
  387.       Else Cright 
  388.       End If 
  389.    End If 
  390.    
  391.    ' Cursor up
  392.    If A=30 and L>0 and SS=>1 and SS<=2
  393.       For PPPP=1 To TSCRHEIGHT
  394.          Dec L
  395.          If Y Curs=1
  396.             Curs Off : Wait Vbl 
  397.             Scroll 1 : Dec YPOS
  398.             Cls 0,0,8 To 624,16
  399.             Locate 0,1 : Print LINE$(L);
  400.             Curs On 
  401.          Else Cup 
  402.          End If 
  403.          If X>Len(LINE$(L)) : X=Len(LINE$(L)) : End If 
  404.          Locate X,Y Curs
  405.          Exit If L=0
  406.       Next 
  407.       Clear Key 
  408.    End If 
  409.    
  410.    
  411.    If A=30 and L>0 and SS=0
  412.       Dec L
  413.       If Y Curs=1
  414.          Curs Off : Wait Vbl 
  415.          Scroll 1 : Dec YPOS
  416.          Cls 0,0,8 To 624,16
  417.          Locate 0,1 : Print LINE$(L);
  418.          Curs On 
  419.       Else Cup 
  420.       End If 
  421.       If X>Len(LINE$(L)) : X=Len(LINE$(L)) : End If 
  422.       Locate X,Y Curs
  423.       Clear Key 
  424.    End If 
  425.    
  426.    ' Cursor down
  427.    If A=31 and L<LINES and SS=0
  428.       Inc L
  429.       If Y Curs=TSCRHEIGHT
  430.          Curs Off : Wait Vbl 
  431.          Scroll 2 : Inc YPOS
  432.          Cls 0,0,Screen Height-8 To 624,Screen Height
  433.          Locate 0,TSCRHEIGHT : Print LINE$(L);
  434.          Curs On 
  435.       Else Cdown 
  436.       End If 
  437.       If X>Len(LINE$(L)) : X=Len(LINE$(L)) : End If 
  438.       Locate X,Y Curs
  439.       Clear Key 
  440.    End If 
  441.    
  442.    If A=31 and L<LINES and SS=>1 and SS<=2
  443.       For PPP=1 To TSCRHEIGHT
  444.          Inc L
  445.          If Y Curs=TSCRHEIGHT
  446.             Curs Off : Wait Vbl 
  447.             Scroll 2 : Inc YPOS
  448.             Cls 0,0,Screen Height-8 To 624,Screen Height
  449.             Locate 0,TSCRHEIGHT : Print LINE$(L);
  450.             Curs On 
  451.          Else Cdown 
  452.          End If 
  453.          If X>Len(LINE$(L)) : X=Len(LINE$(L)) : End If 
  454.          Locate X,Y Curs
  455.          Clear Key 
  456.          Exit If L=LINES
  457.       Next 
  458.    End If 
  459.    
  460.    KONIEC:
  461.    SKIP:
  462.    _CURSPOS
  463.    
  464. End Proc
  465. Procedure _CURSPOS
  466.    X=X Curs : Y=Y Curs
  467.    Locate 0,0 : Paper 0
  468.    Print Using "COL: ###  ";X;
  469.    Print Using "LIN: ###  ";L;
  470.    'Print Using " ##";Y 
  471.    Locate X,Y : Paper 0
  472. End Proc
  473. Procedure _ZOOMGRID
  474.    On Error Proc BAD
  475.    Resume Label KONIEC
  476.    Screen 1
  477.    Cls 0
  478.    Add ROT,3,0 To 359
  479.    C=C(ROT) : MC=(500*C)/16384
  480.    S=S(ROT) : MS=(500*S)/16384
  481.    For YY=-200 To 200 Step SZE
  482.       NC=(YY*C)/16384
  483.       NS=(YY*S)/16384
  484.       Draw 320-MC-NS,100+NC-MS To 320+MC-NS,100+NC+MS
  485.       Draw 320+NC+MS,100-MC+NS To 320+NC-MS,100+MC+NS
  486.    Next YY
  487.    Screen Swap 
  488.    Screen 0
  489.    KONIEC:
  490.    Pop Proc
  491. End Proc
  492. Procedure BAD
  493.    Screen Open 5,640,20,8,Hires : Curs Off : Flash Off : Cls 0
  494.    Screen Display 5,,,,10
  495.    For I=0 To 7 : Colour I,I*$222 : Next I
  496.    Double Buffer : Autoback 0 : Paper 0
  497.    
  498.    XXX=1 : YYY=0 : 
  499.    A$=Err$(Errn)
  500.    L=Len(A$)
  501.    For I=1 To Len(A$)+7 : B=I-7 : B=Max(0,B) : C=I+1 : C=Min(C,L)
  502.       For J=C To B Step -1 : A=I-(J-1) : A=Min(Max(A,0),7)
  503.    Pen A : Print At(XXX,YYY),Left$(A$,J) : Next J : Screen Swap 5 : Wait Vbl : Next I
  504.    Repeat 
  505.  
  506.       If WSKAZ=0
  507.          SZE=SZE-2
  508.          _ZOOMGRID
  509.          If SZE=<25
  510.             WSKAZ=1
  511.          End If 
  512.       End If 
  513.       
  514.       If WSKAZ=1
  515.          SZE=SZE+2
  516.          _ZOOMGRID
  517.          If SZE=>300
  518.             WSKAZ=0
  519.          End If 
  520.       End If 
  521.  
  522.    Until Mouse Key<>0 or Inkey$<>""
  523.    Screen Close 5
  524.    Resume Label 
  525. End Proc
  526. '
  527. Procedure REQ
  528.    Screen Open 3,640,200,4,Hires : Curs Off : Flash Off : Cls 0
  529.    Colour 17,$FF0
  530.    Colour 20,$BB0
  531.    Colour 24,$880
  532.    Colour 31,$660
  533.    Palette $AAA,$0,$FFF,$68A
  534.    PATH$=Dir$
  535.    FILT$=""
  536.    PASS=0
  537.    FR[PATH$,FILT$,"Please Select","A Program..."]
  538.    Screen Close 3 : _LMOUSE
  539. End Proc
  540. Procedure FR[PATH$,FILT$,H1$,H2$]
  541.    '
  542.    Screen Open 7,360,160,4,Hires : Curs Off : Flash Off : Cls 0
  543.    Screen Display 7,200,70,, : Palette $AAA,$0,$FFF,$68A
  544.    Colour 17,$FF0
  545.    Colour 20,$BB0
  546.    Colour 24,$880
  547.    Colour 31,$660
  548.    Limit Mouse 194,75 To 365,226
  549.    Gosub _SETUP_SCREEN
  550.    If PASS=0
  551.       PASS=1
  552.    End If 
  553.    If PASS=1
  554.       Goto 55
  555.    End If 
  556.    1
  557.    Locate 2,14 : Print String$(" ",37) : FI$=""
  558.    For Z=1 To H+1
  559.       FILE$(Z)=""
  560.    Next Z
  561.    For Z=8 To 8+H
  562.       Locate 2,Z
  563.       Print String$(" ",37)
  564.    Next Z
  565.    Gosub _GET_DIR
  566.    55
  567.    H=4 : P=1 : OK=1 : FF=1
  568.    Gosub _DISPLAY_DIRECTORY
  569.    Gosub _DISPLAY_WILDCARD
  570.    Do 
  571.       '
  572.       ' *** SELECT FILE  
  573.       '
  574.       For Z=1 To 5
  575.          R[16,64+(Z*8)-8,311,71+(Z*8)-8] : If AN>0 Then FF=P+(Z-1) : OK2=1
  576.       Next Z
  577.       '
  578.       ' *** DISPLAY DIRECTORY & PATH 
  579.       '      
  580.       If OK=1
  581.          Gosub _DISPLAY_DIR
  582.          Gosub _SCROLLY
  583.       End If 
  584.       '
  585.       ' *** SELECT FILE or GET DIRECTORY 
  586.       '
  587.       If OK2=1
  588.          If Mid$(FILE$(FF),30,5)<>"(Dir)"
  589.             Locate 2,14 : Print String$(" ",37)
  590.             Z$=FILE$(FF) : Gosub _SHORTEN : FI$=Z$
  591.             Locate 2,14 : Print FI$
  592.          Else 
  593.             Z$=FILE$(FF) : Gosub _SHORTEN
  594.             If Exist(PATH$+Z$)
  595.                PATH$=PATH$+Z$+"/"
  596.                OK2=0 : Goto 1
  597.             End If 
  598.          End If 
  599.          OK2=0
  600.       End If 
  601.       '
  602.       ' *** ENTER NEW DIRECTORY
  603.       '
  604.       R[12,45,315,59]
  605.       If AN>0 : Locate 2,6 : Print String$(" ",37)
  606.          ED[PATH$,100,2,6,37,0]
  607.          If(Right$(ED$,1)<>"/") and(Right$(ED$,1)<>":") : ED$=ED$+"/" : End If 
  608.          If Exist(ED$) : PATH$=ED$ : Goto 1 : End If 
  609.          Gosub _DISPLAY_DIRECTORY
  610.       End If 
  611.       '
  612.       ' *** ENTER FILENAME & EXIT
  613.       '
  614.       R[12,109,315,123]
  615.       If AN>0 : T$="" : Locate 2,14 : Print String$(" ",37)
  616.          ED[FI$,100,2,14,37,0]
  617.          If ED$=""
  618.             Goto 3
  619.          End If 
  620.          If Exist(PATH$+ED$) : FI$=PATH$+ED$ : Goto FINISH : End If 
  621.          Locate 2,14 : Print String$(" ",37)
  622.       End If 
  623.       3
  624.       '
  625.       ' *** ENTER WILDCARD & GET NEW DIR 
  626.       '
  627.       R[260-8,133,315,147]
  628.       If AN>0
  629.          ED[FILT$,100,32,17,6,0] : FILT$=ED$
  630.       Goto 1 : End If 
  631.       '
  632.       ' *** UP ONE FILE
  633.       '
  634.       R[324,133,339,147]
  635.       If AN>0 and P<N-H : Inc P : OK=1 : End If 
  636.       '
  637.       ' *** DOWN ONE FILE
  638.       '
  639.       R[324,13,339,27]
  640.       If AN>0 and P>1 : Dec P : OK=1 : End If 
  641.       '
  642.       ' *** CANCEL 
  643.       '
  644.       R[12,133,83,147]
  645.       If AN>0 Then FI$="" : Goto FINISH
  646.       '
  647.       ' *** PARENT 
  648.       '
  649.       R[124-32,133,203-32-8,147]
  650.       If AN>0
  651.          If PATH$<>""
  652.             For Z=Len(PATH$)-1 To 1 Step -1
  653.                A$=Mid$(PATH$,Z,1)
  654.                If(A$="/") or(A$=":") : PATH$=Left$(PATH$,Z) : Exit : End If 
  655.             Next 
  656.          End If 
  657.          Goto 1
  658.       End If 
  659.       '
  660.       ' *** O.K! 
  661.       '
  662.       R[244-64-8,133,315-64-8,147]
  663.       If AN>0
  664.          FI$=PATH$+FI$
  665.          Goto FINISH
  666.       End If 
  667.       '
  668.    Loop 
  669.    '
  670.    ' *********************************  
  671.    _SCROLLY:
  672.    Ink 0 : Bar 325,30 To 338,130
  673.    If N>(H+1)
  674.       Y1=30+(100*(P-1))/N
  675.       Y2=Min(30+100,Y1+(100*H)/N)
  676.       B[325,Y1,338,Y2,"",1]
  677.    Else 
  678.       B[325,30,338,130,"",1]
  679.    End If 
  680.    Return 
  681.    '
  682.    _SHORTEN:
  683.    For Z=29 To 1 Step -1
  684.       If Mid$(Z$,Z,1)<>" " : Z$=Left$(Z$,Z) : Exit : End If 
  685.    Next Z
  686.    Return 
  687.    '
  688.    _GET_DIR:
  689.    N=0
  690.    A$=Dir First$(PATH$+FILT$)
  691.    While A$<>""
  692.       N=N+1
  693.       If Left$(A$,1)<>"*"
  694.          FILE$(N)=Mid$(Left$(A$,Len(A$)),2)
  695.       Else 
  696.          FILE$(N)=Mid$(A$,2)
  697.          Mid$(FILE$(N),30,5)="(Dir)"
  698.       End If 
  699.       A$=Dir Next$
  700.    Wend 
  701.    Return 
  702.    '
  703.    _DISPLAY_DIR:
  704.    Y=8
  705.    For Z=P To P+H
  706.       Locate 2,Y
  707.       Print FILE$(Z)
  708.       Inc Y
  709.    Next 
  710.    OK=0
  711.    Return 
  712.    '
  713.    _DISPLAY_DIRECTORY:
  714.    Locate 2,6 : Print String$(" ",37)
  715.    Locate 2,6 : Print Left$(PATH$,37)
  716.    Return 
  717.    '
  718.    _DISPLAY_WILDCARD:
  719.    Locate 32,17 : Print String$(" ",7)
  720.    Locate 32,17 : Print Left$(FILT$,7) : Return 
  721.    '
  722.    _SETUP_SCREEN:
  723.    Pen 1 : Paper 0
  724.    T[1,1,42,18,"",1] : Rem Main Border
  725.    T[41,2,1,1,"<",1] : Rem Back 1 File
  726.    T[41,17,1,1,">",1] : Rem One 1 File 
  727.    T[41,4,1,12,"",0] : Rem Scrolly Thing
  728.    Set Text 2
  729.    T[2,2,37,1,H1$,1] : Rem Heading One
  730.    T[2,4,37,1,H2$,1] : Rem Heading Two
  731.    Set Text 0
  732.    T[2,6,37,1,"",0] : Rem Display Directory  
  733.    T[2,8,37,5,"",1] : Rem Display Files
  734.    T[2,14,37,1,"",0] : Rem Display File 
  735.    T[2,17,8,1,"CANCEL",1]
  736.    T[12,17,8,1,"PARENT",1]
  737.    T[22,17,8,1,"O.K!",1]
  738.    T[32,17,7,1,"",0]
  739.    Return 
  740.    '
  741.    FINISH:
  742.    Screen Close 7
  743.    '
  744. End Proc
  745. Procedure R[X1,Y1,X2,Y2]
  746.    AN=False : X4=X Screen(X Mouse) : Y4=Y Screen(Y Mouse)
  747.    If X4<X1 or X4>X2 or Y4<Y1 or Y4>Y2 Then Pop Proc
  748.    Gr Writing 2
  749.    While Mouse Key>0
  750.       X4=X Screen(X Mouse) : Y4=Y Screen(Y Mouse)
  751.       If X4>X1 and X4<X2 and Y4>Y1 and Y4<Y2 and AN=False Then Bar X1,Y1 To X2,Y2 : AN=Mouse Key
  752.       If AN Then If X4<X1 or X4>X2 or Y4<Y1 or Y4>Y2 Then Bar X1,Y1 To X2,Y2 : AN=False
  753.    Wend 
  754.    If AN Then Bar X1,Y1 To X2,Y2
  755.    Gr Writing 1
  756. End Proc
  757. Procedure B[X1,Y1,X2,Y2,A$,IN]
  758.    If IN=1
  759.       C1=2
  760.       C2=1
  761.    Else 
  762.       C1=1
  763.       C2=2
  764.    End If 
  765.    Ink 0
  766.    Bar X1,Y1 To X2,Y2
  767.    Ink C1
  768.    Box X1,Y1 To X2,Y2
  769.    Ink C2
  770.    Polyline X1,Y2 To X2,Y2 To X2,Y1+1
  771.    If A$<>""
  772.       W=Text Length(A$)
  773.       X7=(((X2-X1)/2)+X1)-(W/2)
  774.       Ink 1,0
  775.       Text X7,((Y2-Y1)/2)+Y1+3,A$
  776.    End If 
  777. End Proc
  778. Procedure T[X,Y,W,H,T$,IN]
  779.    X1=(X*8)-4 : Y1=(Y*8)-3 : X2=X1+(W*8)+7 : Y2=Y1+(H*8)+6
  780.    B[X1,Y1,X2,Y2,T$,IN]
  781. End Proc
  782. Procedure ED[ED$,XC,XX,YY,SX,MN]
  783.    PX=0 : L=Len(ED$) : If L>=SX : PX=L-SX : End If 
  784.    XC=Max(0,XC) : XC=Min(XC,L)
  785.    Curs On 
  786.    Do 
  787.       Gosub _DED
  788.       Repeat 
  789.          A$=Inkey$ : S=Scancode
  790.          If Mouse Key=1
  791.             X=(X Screen(X Mouse))/8-XX
  792.             If X>=MN and X<=L : XC=X : Gosub _DED : Wait Vbl : End If 
  793.          End If 
  794.       Until A$<>""
  795.       F=1
  796.       If A$=Chr$(13) : Exit : End If 
  797.       If A$=Chr$(27) : ED$="_Esc_" : Exit : End If 
  798.       If S=65 and XC+PX>MN
  799.          ED$=Left$(ED$,XC+PX-1)+Mid$(ED$,PX+XC+1) : E=1 : L=L-1
  800.          S=79
  801.       End If 
  802.       If S=70 and XC+PX<L
  803.          ED$=Left$(ED$,XC+PX)+Mid$(ED$,PX+XC+2) : E=1 : L=L-1 : F=0
  804.       End If 
  805.       If S=79 and PX+XC>MN
  806.          F=0
  807.          If XC=0
  808.             PX=PX-1
  809.          Else 
  810.             XC=XC-1
  811.          End If 
  812.       End If 
  813.       If S=78 and PX+XC<L
  814.          F=0
  815.          If XC=SX
  816.             PX=PX+1
  817.          Else 
  818.             XC=XC+1
  819.          End If 
  820.       End If 
  821.       If F
  822.          If A$>=" "
  823.             ED$=Left$(ED$,PX+XC)+A$+Mid$(ED$,PX+XC+1) : L=L+1
  824.             If L>SX
  825.                If XC>=SX
  826.                   PX=PX+1
  827.                Else 
  828.                   XC=XC+1
  829.                End If 
  830.             Else 
  831.                XC=XC+1
  832.             End If 
  833.          End If 
  834.       End If 
  835.    Loop 
  836.    Curs Off 
  837.    Goto _END
  838.    '
  839.    _DED:
  840.    Locate XX,YY : Print Mid$(ED$,PX+1,SX);
  841.    If E : If X Curs<XX+SX : Print " "; : E=0 : End If : End If 
  842.    Locate Min(XX+XC,XX+SX-1),YY
  843.    Return 
  844.    '
  845.    _END:
  846. End Proc
  847. '
  848. Procedure BLOK
  849.    Amos Lock 
  850.    Break Off 
  851.    Close Workbench 
  852.    Request Off 
  853.    Hide 
  854. End Proc